Developer CD Series 1992 June: ROMin Holiday/ADC Developer CD (1992-06) (''ROMin Holiday'')_iso/Developer Connection - 06-1992.iso/Periodicals/develop/develop 8 code/TValidText/UDateTimeText.inc1.p

Text File | 1991-10-09 | 19.1 KB | 792 lines | [TEXT/MPS ]

{*******************************************************************************
UDateTimeText.inc1.p
    Classes implementing the ability to enter dates and times as text in
    dialogs.
*******************************************************************************}

CONST
    kInvalidDateTimeAlert    = 701;        { the ValidationErrorAlert() alert }

{###############################################################################
Implementation Globals (global extent, local scope)
###############################################################################}

VAR
    pDefaultDateForm:    DateForm;        { used by TDateEditText }



{###############################################################################
Global Routines
###############################################################################}

{------------------------------------------------------------------------------}
{$S AInit}

PROCEDURE InitUDateTimeText(
                        theDateForm:    DateForm);
    VAR
        dummy:        BOOLEAN;

    BEGIN
    IF gDeadStripSuppression
    THEN
        BEGIN
        { view classes }
        dummy := Member(TObject(NIL), TDateEditText);
        dummy := Member(TObject(NIL), TTimeEditText);
        END;  { then }

    SetDefaultDateForm(theDateForm);
    END;  { InitUDateTimeText }

{------------------------------------------------------------------------------}
{$S Date_Seg}

PROCEDURE SetDefaultDateForm(
                        theDateForm:    DateForm);
    BEGIN
    pDefaultDateForm := theDateForm;
    END;  { SetDefaultDateForm }

{------------------------------------------------------------------------------}
{$S Date_Seg}

FUNCTION  GetDefaultDateForm
                        :DateForm;
    BEGIN
    GetDefaultDateForm := pDefaultDateForm;
    END;  { GetDefaultDateForm }



{###############################################################################
TDateEditText
###############################################################################}

{------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TDateEditText.IDateEditText(
                        itsSuperView:    TView;
                        itsLocation:    VPoint;
                        itsSize:        VPoint;
                        strict:            BOOLEAN;
                        required:        BOOLEAN;
                        itsDateForm:    INTEGER;
                        itsDateSecs:    LongDateTime);

    BEGIN
    IValidText(itsSuperView, itsLocation, itsSize,
               strict, required, kInvalidDateTimeAlert);

    { set the dates format }
    fDateForm := itsDateForm;

    { set the initial string to match fDateSecs }
    SetDateSecs(itsDateSecs, kDontRedraw);
    END;  { IDateEditText }

{------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TDateEditText.IRes(
                        itsDocument:    TDocument;
                        itsSuperView:    TView;
                    VAR itsParams:        Ptr);
                        OVERRIDE;
    VAR
        theText:        Str255;
        theDate:        LongDateTime;
        result:            String2DateStatus;

    BEGIN
    INHERITED IRes(itsDocument, itsSuperView, itsParams);

    { read extra field from resource }
    WITH DateTextTemplatePtr(itsParams)^ DO
        BEGIN
        fDateForm := theDateForm;
        (*
        {$IFC qDebug}
        writeln;
        writeln('In TDateEditText.IRes()');
        write  ('           fIdentifier = '); WriteSig(fIdentifier); writeln;
        writeln('           theDateForm = ', theDateForm:1);
        {$ENDC qDebug}
        *)
        END;

    { offset the itsParam ptr accordingly }
    OffsetPtr(itsParams, SIZEOF(DateTextTemplate));

    { convert the initial text to a date, and set fDateSecs to that date }
    GetText(theText);
    result := StringToDate(theText, theDate);
    SetDateSecs(theDate, kDontRedraw);
    END;  { IRes }


{------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TDateEditText.WRes(
                        theResource:    ViewRsrcHndl;
                    VAR    itsParams:        Ptr);
                        OVERRIDE;

    VAR
        p:                DateTextTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    p := DateTextTemplatePtr(ExpandPtr(theResource,
                                       itsParams,
                                       SIZEOF(DateTextTemplate)));

    WITH p^ DO
        BEGIN
        theDateForm := fDateForm;
        END;
    END;  { WRes }


{------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TDateEditText.WriteRes(
                        theResource:    ViewRsrcHndl;
                    VAR itsParams:        Ptr);
                        OVERRIDE;

    BEGIN
    gWResSignature := 'date';    { See ViewResourceTypes.r }
    gWResType := 'TDateEditText';
    WRes(theResource, itsParams);
    END;  { WriteRes }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDateEditText.SetDateSecs(
                        dateSecs:        LongDateTime;
                        redraw:            BOOLEAN);

    BEGIN
    fDateSecs := dateSecs;

    UpdateText(redraw);
    END;  { SetDateSecs }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDateEditText.SetDateForm(
                        theDateForm:    INTEGER;
                        redraw:            BOOLEAN);

    BEGIN
    fDateForm := theDateForm;

    UpdateText(redraw);
    END;  { SetDateForm }

{------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION  TDateEditText.GetDateSecs
                        :LongDateTime;
    BEGIN
    GetDateSecs := fDateSecs;
    END;  { GetDateSecs }

{------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION  TDateEditText.GetDateForm
                        :INTEGER;
    BEGIN
    GetDateForm := fDateForm;
    END;  { GetDateForm }

{------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION  TDateEditText.CurrentDateForm
                        :DateForm;
    BEGIN
    IF (fDateForm = kDefDateForm)
    THEN
        CurrentDateForm := GetDefaultDateForm    { use global DateForm }
    ELSE
        CurrentDateForm := DateForm(fDateForm);    { use object's DateForm }
    END;  { CurrentDateForm }

{------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TDateEditText.UpdateText(
                        redraw:            BOOLEAN);
                        OVERRIDE;
    { This routine replaces the text in the object with text that reflects
        the object's fDateSecs and fDateForm values. }

    VAR
        dateSecs:        LongDateTime;
        dateString:        Str255;

    BEGIN
    dateSecs := GetDateSecs;

    IF (dateSecs = kNotADate)
    THEN
        SetText('', redraw)
    ELSE
        BEGIN
        DateToString(dateSecs, CurrentDateForm, dateString);
        SetText(dateString, redraw);
        END;
    END;  { UpdateText }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION  TDateEditText.IsValid(
                    VAR    theText:        Str255;
                    VAR    whyNot:            INTEGER)
                        :BOOLEAN;
                        OVERRIDE;
    { If the text is valid, then this function returns TRUE, and whyNot
        is set to the value noErr (0).  If the text is invalid, then the
        function returns FALSE and whyNot is set to a value indicating
        the reason why the text is invalid. }

    VAR
        theError:        INTEGER;
        valid:            BOOLEAN;
        dateSecs:        LongDateTime;

    BEGIN
    IF (NOT INHERITED IsValid(theText, theError))
    THEN
        BEGIN
        valid  := FALSE;
        whyNot := theError;
        END
    ELSE
        BEGIN
        theError := StringToDate(theText, dateSecs);

        IF fStrict
        THEN
            valid := (theError = noErr) | (theError = longDateFound)
        ELSE
            valid := (theError >= noErr);

        IF (theError = dateTimeNotFound) &    { no date was found }
           (NOT fRequired) &                { empty strings are OK }
           (Length(theText) = 0)            { and the string is empty }
        THEN
            valid := TRUE;  { empty string OK if entry is not required }

        IF valid
        THEN
            whyNot := noErr
        ELSE
            whyNot := theError;
        END;

    IsValid := valid;

    (*
    {$IFC qDebug}
        writeln;
        writeln('In TDateEditText.IsValid():');
        writeln('                theText = "', theText, '"');
        write  ('                 whyNot = '); WriteHexInt(whyNot); writeln;
        write  ('               theError = '); WriteHexInt(theError); writeln;
        write  ('                  valid = '); WriteBoolean(valid); writeln;
    {$ENDC qDebug}
    *)
    END;  { IsValid }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION  TDateEditText.HandleValidText(
                    VAR    theText:        Str255)
                        :LONGINT;
                        OVERRIDE;
    { This routine always returns kValidValue.  In its OVERRIDES, it
        might update SELF's internal instance variables to reflect
        the valid text. }
    VAR
        status:            String2DateStatus;
        dateSecs:        LongDateTime;

    BEGIN
    { We already called StringToDate() in IsValid(), and lost the result; but
        a little redundancy never hurts.  A little redundancy never hurts. }
    status := StringToDate(theText, dateSecs);
    SetDateSecs(dateSecs, kRedraw);

    HandleValidText := INHERITED HandleValidText(theText);
    END;  { HandleValidText }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDateEditText.ErrorToString(
                        theError:        INTEGER;
                    VAR    theString:        Str255);
                        OVERRIDE;
    { This routine sets theString to the string which best explains
        the given error.  It is intended to be called only from
        PrepareErrorAlert(). }
    VAR
        strIndex:        INTEGER;

    BEGIN
    CASE theError OF
        leftOverChars:        strIndex :=  2;
        sepNotIntlSep:        strIndex :=  3;
        fieldOrderNotIntl:    strIndex :=  4;
        extraneousStrings:    strIndex :=  5;
        tooManySeps:        strIndex :=  6;
        sepNotConsistent:    strIndex :=  7;
        tokenErr:            strIndex :=  8;
        cantReadUtilities:    strIndex :=  9;
        dateTimeNotFound:    strIndex := 10;
        dateTimeInvalid:    strIndex := 11;

        OTHERWISE            strIndex :=  0;
        END;  { case theError }

    IF (strIndex > 0)
    THEN
        GetIndString(theString, kInvalidDateReasons, strIndex)
    ELSE
        INHERITED ErrorToString(theError, theString);

    (*
    {$IFC qDebug}
    writeln;
    write('In TDateEditText.ErrorToString(), theString = "', theString,
          '" and theError = ');
    WriteHexInt(theError);
    writeln;
    {$ENDC qDebug}
    *)
    END;  { ErrorToString }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TDateEditText.PrepareErrorAlert(
                    VAR    theText:        Str255;
                        theError:        INTEGER);
                        OVERRIDE;
    { The routine sets up the dialog that is displayed by
        ValidationErrorAlert(). }

    VAR
        errString:        Str255;
        dateSecs:        LongDateTime;
        dateString:        Str255;

    BEGIN
    { get the best string to describe the given error }
    ErrorToString(theError, errString);

    { get the current date, as a string }
    GetCurrentDate(dateSecs);
    DateToString(dateSecs, shortDate, dateString);

    ParamText(errString, dateString, '', '');
    END;  { PrepareErrorAlert }

{------------------------------------------------------------------------------}
{$S DlgFields}

{$IFC qInspector}
PROCEDURE TDateEditText.Fields(
                        PROCEDURE DoToField(
                            fieldName:        Str255;
                            fieldAddr:        Ptr;
                            fieldType:        INTEGER));
                        OVERRIDE;
    VAR
        aStr:            Str255;
        theSecs:        LongDateTime;

    BEGIN
    DoToField('TDateEditText', NIL, bClass);

    CASE fDateForm OF
        ord(shortDate):        aStr := 'shortDate';
        ord(longDate):        aStr := 'longDate';
        ord(abbrevDate):    aStr := 'abbrevDate';
        kDefDateForm:        aStr := 'defDateForm';
        OTHERWISE            aStr := '<unknown>';
        END;  { case fDateForm }

    DoToField('fDateForm', @aStr, bString);

    { now, the fDateSecs field }
    theSecs := fDateSecs;
    DateToString(theSecs, abbrevDate, aStr);
    DoToField('fDateSecs', @aStr, bString);

    INHERITED Fields(DoToField);
    END;  { Fields }
{$ENDC qDebug}



{###############################################################################
TTimeEditText
###############################################################################}

{------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TTimeEditText.ITimeEditText(
                        itsSuperView:    TView;
                        itsLocation:    VPoint;
                        itsSize:        VPoint;
                        strict:            BOOLEAN;
                        required:        BOOLEAN;
                        wantSeconds:    BOOLEAN;
                        itsTimeSecs:    LONGINT);

    BEGIN
    IValidText(itsSuperView, itsLocation, itsSize,
               strict, required, kInvalidDateTimeAlert);

    fWantSeconds := wantSeconds;

    { set the initial string to match fTimeSecs }
    SetTimeSecs(itsTimeSecs, kDontRedraw);
    END;  { ITimeEditText }

{------------------------------------------------------------------------------}
{$S DlgOpen}

PROCEDURE TTimeEditText.IRes(
                        itsDocument:    TDocument;
                        itsSuperView:    TView;
                    VAR itsParams:        Ptr);
                        OVERRIDE;
    VAR
        theText:        Str255;
        theTime:        LONGINT;
        result:            String2DateStatus;

    BEGIN
    INHERITED IRes(itsDocument, itsSuperView, itsParams);

    { read extra field from resource }
    WITH TimeTextTemplatePtr(itsParams)^ DO
        BEGIN
        fWantSeconds  := wantSeconds;
        END;

    { offset the itsParam ptr accordingly }
    OffsetPtr(itsParams, SIZEOF(TimeTextTemplate));

    { set fTimeSecs to match the initial string }
    GetText(theText);
    result := StringToTime(theText, theTime);
    SetTimeSecs(theTime, kDontRedraw);
    END;  { IRes }


{------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TTimeEditText.WRes(
                        theResource:    ViewRsrcHndl;
                    VAR    itsParams:        Ptr);
                        OVERRIDE;

    VAR
        p:                TimeTextTemplatePtr;

    BEGIN
    INHERITED WRes(theResource, itsParams);

    p := TimeTextTemplatePtr(ExpandPtr(theResource,
                                       itsParams,
                                       SIZEOF(TimeTextTemplate)));

    WITH p^ DO
        BEGIN
        wantSeconds := fWantSeconds;
        reserved := FALSE;
        END;
    END;  { WRes }


{------------------------------------------------------------------------------}
{$S MAWriteRes}

PROCEDURE TTimeEditText.WriteRes(
                        theResource:    ViewRsrcHndl;
                    VAR itsParams:        Ptr);
                        OVERRIDE;

    BEGIN
    gWResSignature := 'time';    { See ViewResourceTypes.r }
    gWResType := 'TTimeEditText';
    WRes(theResource, itsParams);
    END;  { WriteRes }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TTimeEditText.SetTimeSecs(
                        timeSecs:        LONGINT;
                        redraw:            BOOLEAN);

    BEGIN
    fTimeSecs := timeSecs;

    UpdateText(redraw);
    END;  { SetTimeSecs }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TTimeEditText.SetWantSeconds(
                        wantSeconds:    BOOLEAN;
                        redraw:            BOOLEAN);
    BEGIN
    fWantSeconds := wantSeconds;

    UpdateText(redraw);
    END;  { SetWantSeconds }

{------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION  TTimeEditText.GetTimeSecs
                        :LONGINT;
    BEGIN
    GetTimeSecs := fTimeSecs;
    END;  { GetTimeSecs }

{------------------------------------------------------------------------------}
{$S DlgRes}

FUNCTION  TTimeEditText.GetWantSeconds
                        :BOOLEAN;
    BEGIN
    GetWantSeconds := fWantSeconds;
    END;  { GetWantSeconds }

{------------------------------------------------------------------------------}
{$S DlgRes}

PROCEDURE TTimeEditText.UpdateText(
                        redraw:            BOOLEAN);
                        OVERRIDE;
    { This routine replaces the text in the object with text that reflects
        the object's fTimeSecs and fWantSeconds values. }

    VAR
        timeSecs:        LONGINT;
        timeString:        Str255;

    BEGIN
    timeSecs := GetTimeSecs;

    IF (timeSecs = kNotATime)
    THEN
        SetText('', redraw)
    ELSE
        BEGIN
        TimeToString(timeSecs, fWantSeconds, timeString);
        SetText(timeString, redraw);
        END;
    END;  { UpdateText }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION  TTimeEditText.IsValid(
                    VAR    theText:        Str255;
                    VAR    whyNot:            INTEGER)
                        :BOOLEAN;
                        OVERRIDE;
    { If the text is valid, then this function returns TRUE, and whyNot
        is set to the value noErr (0).  If the text is invalid, then the
        function returns FALSE and whyNot is set to a value indicating
        the reason why the text is invalid. }

    VAR
        theError:        INTEGER;
        valid:            BOOLEAN;
        timeSecs:        LONGINT;

    BEGIN
    IF (NOT INHERITED IsValid(theText, theError))
    THEN
        BEGIN
        valid := FALSE;
        whyNot := theError;
        END
    ELSE
        BEGIN
        theError := StringToTime(theText, timeSecs);

        IF fStrict
        THEN
            valid := (theError = noErr) | (theError = longDateFound)
        ELSE
            valid := (theError >= noErr);

        IF (theError = dateTimeNotFound) &    { no date was found }
           (NOT fRequired) &                { empty strings are OK }
           (Length(theText) = 0)            { and the string is empty }
        THEN
            valid := TRUE;

        IF valid
        THEN
            whyNot := noErr
        ELSE
            whyNot := theError;
        END;

    IsValid := valid;

    {$IFC qDebug}
        (*
        writeln;
        WrLblHexInt('In TTimeEditText.IsValid(), theError', theError);
        writeln;
        WrLblHexInt('                              whyNot', whyNot);
        writeln;
        WrLblBoolean('                               valid', valid);
        writeln;
        *)
    {$ENDC qDebug}
    END;  { IsValid }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

FUNCTION  TTimeEditText.HandleValidText(
                    VAR    theText:        Str255)
                        :LONGINT;
                        OVERRIDE;
    { This routine always returns kValidValue.  In its OVERRIDES, it
        might update SELF's internal instance variables to reflect
        the valid text. }
    VAR
        status:            String2DateStatus;
        timeSecs:        LONGINT;

    BEGIN
    { We already called StringToTime() in IsValid(), and lost the result; but
        a little redundancy never hurts.  A little redundancy never hurts. }
    status := StringToTime(theText, timeSecs);
    SetTimeSecs(timeSecs, kRedraw);

    HandleValidText := kValidValue;
    END;  { HandleValidText }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TTimeEditText.ErrorToString(
                        theError:        INTEGER;
                    VAR    theString:        Str255);
                        OVERRIDE;
    { This routine sets theString to the string which best explains
        the given error.  It is intended to be called only from
        PrepareErrorAlert(). }
    VAR
        strIndex:        INTEGER;

    BEGIN
    CASE theError OF
        leftOverChars:        strIndex :=  2;
        sepNotIntlSep:        strIndex :=  3;
        fieldOrderNotIntl:    strIndex :=  4;
        extraneousStrings:    strIndex :=  5;
        tooManySeps:        strIndex :=  6;
        sepNotConsistent:    strIndex :=  7;
        tokenErr:            strIndex :=  8;
        cantReadUtilities:    strIndex :=  9;
        dateTimeNotFound:    strIndex := 10;
        dateTimeInvalid:    strIndex := 11;

        OTHERWISE            strIndex :=  0;
        END;  { case theError }

    IF (strIndex > 0)
    THEN
        GetIndString(theString, kInvalidTimeReasons, strIndex)
    ELSE
        INHERITED ErrorToString(theError, theString);

    {$IFC qDebug}
    (*
    writeln;
    write('In TDateEditText.ErrorToString(), theString = "', theString,
          '" and theError = ');
    WriteHexInt(theError);
    writeln;
    *)
    {$ENDC qDebug}
    END;  { ErrorToString }

{------------------------------------------------------------------------------}
{$S DlgNonRes}

PROCEDURE TTimeEditText.PrepareErrorAlert(
                    VAR    theText:        Str255;
                        theError:        INTEGER);
                        OVERRIDE;
    { The routine sets up the dialog that is displayed by
        ValidationErrorAlert(). }

    VAR
        errString:        Str255;
        timeSecs:        LONGINT;
        timeString:        Str255;

    BEGIN
    { get the best string to describe the given error }
    ErrorToString(theError, errString);

    { get the current time, as a string }
    GetCurrentTime(timeSecs);
    TimeToString(timeSecs, kDontWantSeconds, timeString);

    ParamText(errString, timeString, '', '');
    END;  { PrepareErrorAlert }

{------------------------------------------------------------------------------}
{$S DlgFields}

{$IFC qInspector}
PROCEDURE TTimeEditText.Fields(
                        PROCEDURE DoToField(
                            fieldName:        Str255;
                            fieldAddr:        Ptr;
                            fieldType:        INTEGER));
                        OVERRIDE;
    BEGIN
    DoToField('TTimeEditText', NIL, bClass);

    DoToField('fTimeSecs',        @fTimeSecs,        bLongint);
    DoToField('fWantSeconds',    @fWantSeconds,    bBoolean);

    INHERITED Fields(DoToField);
    END;  { Fields }
{$ENDC qDebug}

{------------------------------------------------------------------------------}